1 Objectifs :

  • Nous essayons de déterminer le nombre optimal de topic à retenir, k, notre principal hyperparamètre.
  • Nous essayons d’obtenir des formes fortes de notre topic modelling pour consolider nos topics à travers les termes qui les caractérisent

Nous avions des soucis avec la LDA la semaine dernière liés à la reproductibilité (seed non fixés) et liés aux métriques d’évaluation des topics. La fonction utilisée ne permettait pas de récupérer plus que les coefficients beta (et les mots ayant le coeff beta le plus élevé pour chaque topic).

La fonction stm permet de fixer une seed et de récupérer plus de métriques, comme nous allons le développer plus tard.

La préparation des données est légèrement différentes, il faut préparer le vocabulaire (ensemble de tous les mots) ainsi que les documents (noms des documents => n° des PAT).

2 Préparation

# Préparation des documents

# Importation de res lemmat (voir Rapport du 04-12-25)
load(file = "res.lemmat.RData")

# step 1 : Create the Vocabulary
vocab <- unique(res.lemmat$lem.f) # => liste unique de mots 
head(vocab)
## [1] "portrait"    "situer"      "croiser"     "région"      "département"
## [6] "confluence"
# step 2 :  Create a Word-to-Index Mapping
# on va associer les numéros des mots dans le vocabulaire  (chaque mot prend un numero)
word_to_idx <- setNames(seq_along(vocab), vocab)
head(word_to_idx)
##    portrait      situer     croiser      région département  confluence 
##           1           2           3           4           5           6
# Step 3: Count Word Occurrences per Document
# Group by document and count occurrences of each word
doc_word_counts <- res.lemmat %>%
  group_by(doc, lem.f) %>%
  summarise(count = n(), .groups = 'drop')
# we count the frequency of each word in each document 
head(doc_word_counts)
# step4 4 : create document list 
# Get unique documents in order => liste des documents 
unique_docs <- unique(res.lemmat$doc)
head(unique_docs)  # correspondent aux lignes de la BDD qui ont une description (ex : la n°3 n'en a pas)
## [1] "text1" "text2" "text4" "text5" "text6" "text8"
# Create the documents list
documents <- lapply(unique_docs, function(current_doc) {
  # Filter words for this document
  words_in_doc <- doc_word_counts %>%
    filter(doc == current_doc)
  
  # Convert words to indices
  indices <- as.integer(word_to_idx[words_in_doc$lem.f])
  counts <- as.integer(words_in_doc$count)
  
  # Create 2-row matrix: row 1 = indices, row 2 = counts
  matrix(c(indices, counts), nrow = 2, byrow = TRUE)
})
# on va créer une liste qui contient autant d'éléménts qu'il n'y a de textes, dans chaque élément, il y a les identifiants des mots qui sont cités dans le vocabulaire (le n° du mot ) et sa fréquence d'apparition dans ce texte

# Name the documents (optional but recommended)
names(documents) <- unique_docs

documents[[1]][1,1] # le premier mot du text 1 (par ordre alphabetique) est le numéro 135
## [1] 135
vocab[135]
## [1] "accessible"
documents[[1]][2,1] # il apparait une seule fois dans ce doc 
## [1] 1
# Step 5 : prep with prep documents
out <- prepDocuments(documents, vocab, 
                     lower.thresh = 1,  # remove words appearing in only 1 doc
                     upper.thresh = Inf)
## Removing 1628 of 4338 terms (1628 of 41418 tokens) due to frequency 
## Your corpus now has 360 documents, 2710 terms and 39790 tokens.
documents <- out$documents
vocab <- out$vocab

save(documents, file = "documents.RData")
save(vocab, file = "vocab.RData")

3 Modèle et métriques

On va ensuite créer une fonction qui créé le modèle de topic modelling avec la fonction stm.

lda.model <- function(k, seed) {
  topic_model<-stm(documents, 
                   vocab,
                   K=k, verbose=FALSE, init.type = "LDA", 
                   seed = seed)
  
  return(topic_model)
}

Exemple de fonctionnement de la fonction et des sorties :

modeltest <- lda.model(k = 9, seed = 1234)
summary(modeltest)
## A topic model with 9 topics, 360 documents and a 2710 word dictionary.
## Topic 1 Top Words:
##       Highest Prob: agricole, agriculture, commun, population, métropole, culture, communauté 
##       FREX: métropole, démographique, urbain, pôle, caractériser, regrouper, près 
##       Lift: lin, contrairement, équin, théorique, mètre, trace, stimuler 
##       Score: démographique, suisse, normand, lin, plaine, regrouper, agglomération 
## Topic 2 Top Words:
##       Highest Prob: alimentaire, alimentation, pat, durable, action, local, territorial 
##       FREX: engager, action, contrat, éducation, élaboration, lutte, plan 
##       Lift: dénutrition, consulaire, pointe, recouper, restitution, pilote, assemblée 
##       Score: cirque, not, réunion, pad, bordelais, fédérer, pou 
## Topic 3 Top Words:
##       Highest Prob: alimentaire, local, commun, produit, population, également, production 
##       FREX: touristique, tourisme, petit, bénéficiaire, arboriculture, régional, aop 
##       Lift: châtaigne, fonds, internet, identitaire, organisationnel, calcaire, ski 
##       Score: estival, dénombrer, plastique, parisien, méridional, façade, boutique 
## Topic 4 Top Words:
##       Highest Prob: agricole, alimentaire, exploitation, an, important, faible, agriculture 
##       FREX: ménage, faible, taux, moyenne, inférieur, national, élevé 
##       Lift: contraignant, chaud, température, désert, distribuer, croître, espérance 
##       Score: médian, inférieur, moyenne, faiblesse, sau, faible, agglo 
## Topic 5 Top Words:
##       Highest Prob: agricole, alimentaire, enjeu, production, local, foncier, climatique 
##       FREX: changement, adaptation, climatique, valorisation, foncier, génération, renouvellement 
##       Lift: déterminer, certification, incitation, trait, emparer, fonctionnalité, généralisé 
##       Score: friche, accord, fonctionnalité, changement, certification, économe, rhd 
## Topic 6 Top Words:
##       Highest Prob: alimentaire, alimentation, enjeu, agricole, local, qualité, production 
##       FREX: défi, réduire, modèle, carbone, mode, maladie, atlantique 
##       Lift: triple, priorisation, biomasse, surmonter, exacerber, méthode, acheminement 
##       Score: atlantique, empreinte, protéine, maladie, géopolitique, modèle, durablement 
## Topic 7 Top Words:
##       Highest Prob: exploitation, production, agricole, élevage, local, produit, agriculture 
##       FREX: cheptel, lait, bovin, volaille, porcin, ovin, élevage 
##       Lift: porc, acceptation, horaire, fertilisant, estive, ugb, recevoir 
##       Score: provençal, volaille, cheptel, utiliser, perdre, sau, horaire 
## Topic 8 Top Words:
##       Highest Prob: local, collectif, produit, restauration, production, alimentaire, circuit 
##       FREX: collectif, restauration, demander, logistique, circuit, approvisionnement, consommateur 
##       Lift: boucherie, sourcing, gustatif, régularité, casier, coup, comparativement 
##       Score: logistique, restauration, plateforme, sourcing, produit, rapprocher, bouche 
## Topic 9 Top Words:
##       Highest Prob: enjeu, pat, local, action, alimentation, agricole, développement 
##       FREX: schéma, stratégique, soin, bocage, affirmer, ruralité, comité 
##       Lift: vivable, fourche, récemment, certifié, authentique, moderne, élaboré 
##       Score: schéma, comité, capable, pilotage, r, renouer, moderne

Une première méthode à laquelle nous avons pensé consistait à afficher un graphique à la manière des valeurs propres en ACP pour décider du nombre de topics que l’on choisit pour notre LDA. On a créé une fonction qui prend en compte 2 arguments (nstart et nend), qui correspondent aux valeurs minimum et maximum du nombre de topics qu’on fixe dans notre LDA, la fonction teste pour toutes les valeurs de k comprises dans cet intervalle.

#On charge le simple triplet matrix que nous avions fait dans le rapport du 04-12
stm <- load(file="stm.RData")
# install.packages("topicdoc")
library(topicdoc)
library(tidyverse)
load(file = 'stm.RData')

#Fonction visant à produir un graph montrant la cohérence moyenne des topicss proposé à la sortie d'une LDA entre 2 valeurs du nombre de topics
# nstart : nombre de topics minimum
# nend : nombre de topics maximum
# La fonction a un pas de 1 pour les valeurs de k, il est donc recommandé de ne pas mettre des valeurs trop éloignées 

coherence_graph <- function(nstart,nend){
  L <- as.data.frame(matrix(nrow=nend-nstart+1,ncol=2))
  colnames(L) <- c("k","min_coherence")
  L$k <- nstart:nend
  
  for (k_topic in nstart:nend){
    lda_model <- LDA(stm, k = k_topic, method = "Gibbs",
                     control = list(seed = as.integer(800)))
    
    L$min_coherence[k_topic-nstart+1] <- min(topic_coherence(lda_model,stm))
  }
  return(L)
}

coherence <- coherence_graph(2,5)

coherence %>% ggplot(aes(x=k,y=min_coherence)) +
    geom_line() +
    geom_point() +
  ggtitle("Cohérence moyenne des topics en fonction du nombre de topics")

On récupère les 7 mots qui ont les scores les plus élevés par TOPIC pour les métriques suivantes : - coefficients beta : rappel => probabilité d’appartenance d’un terme dans un topic

  • FREX : indice de fréquence exclusivité => moyenne harmonique pondérée dans laquelle le rang du mot est une combinaison de sa fréquence et de son exclusivité. La formule est :

\[\text{FREX}_{f,k} = \left( \frac{w}{\text{ECDF}_{\varphi,k}(\varphi_{f,k})} + \frac{1-w}{\text{ECDF}_{\mu,k}(\mu_{f,k})} \right)^{-1}\]

avec :

  • k : le topic
  • w : paramètre de poids (% associé à l’exclusivité et 1-w = % associé à la fréquence), par défaut w= 0.5
  • la puissance -1 est une moyenne harmonique prenant en compte les deux termes suivants :

terme 1 - ECDF = fonction de répartition empirique cumulative des fréquences des mots d’un thème - \(\varphi_{f,k}\) = fréquence du mot f dans le topic k

terme 2 : - \(\mu_{f,k}\) : exclusivité d’un mot f dans un topic k - fonction de répartition empirique cumulative des exclusivité dans le topic k

Cet indice met l’accent sur des mots typiques et plus exclusifs des thèmes. La fréquence de certains termes très génériques présents dans le corpus et qui se retrouvent dans de nombreux thèmes (alimentaire, alimentation, territoire). Les mots avec le score le plus élevé sont ceux qui sont à la fois assez fréquents et à la fois assez exclusifs à un thème Bischof et al, 2012

On va ensuite créer une fonction qui va récupérer les mots qui caractérisent le plus nos topics extraits.

=> il faut donc choisir les métriques qui nous intéressent :

topic.extraction <- function(topic_model) {
  
  # récupérer les mots avec les indices FREX (Fréquence exclusivité) les plus forts 
  frex <- data.frame(t(summary(topic_model)$frex))
  
  # beta <-  data.frame(t(summary(topic_model)$prob)) # et les scores beta les plus élevés 
  
  # créer liste_mots
  # liste_mots <- rbind(frex,beta)
  colnames(frex) <- paste0("topic",seq(from=1,to=9))
  
  list <- sapply(frex, paste, collapse = " ")
  list <- str_split(list, pattern = " ")
  
  return (list)
}

Extraction des termes de chaque thème avec Beta et frex et montrer que frex est plus discriminant :

# On utilise NaileR pour faire une extraction automatique de nos variables latentes
library(NaileR)

# à faire plus tard

# avec FREX

# avec scores BETA

4 Méthodologie

On va ensuite essayer de créer des “formes fortes” , en réalisant de nombreuses fois la LDA, puis en supprimant les mots les moins fréquents (n’apparaissant par exemple que dans un seul topic d’une seule LDA), et en regardant comment les mêmes mots s’associent de la même façon ensemble avec plusieurs itérations de l’algorithme. Les mots ne sont pas mis dans le même topic à chaque LDA, donc le ‘topic 1’ de la ‘lda1’ n’est pas le même que le ‘topic1’ de la ‘lda2’ mais s’il y a une stabilité dans les thèmes alors les mêmes mots se retrouveront dans les mêmes topics, et l’on s’intéresse justement aux termes qui composent ces topics (= la variable latente à nommer) plutôt qu’aux topics (1, 2, … etc) en eux-mêmes.

Nous avons testé plusieurs K, (9, 10, 15) et nous avons décidé de conserver k = 9 (augmenter le nombre de topics a eut pour effet que les mots associés dans les topics n’est pas forcément de sens ensemble donc la construction de l’espace latent des topics et la classification étaient peu satisfaisantes).

Nous avons essayé de réaliser la procédure en gardant les termes ayant les frex et les scores beta les plus élevés, et après avoir testé avec uniquement les scores frex, les groupes sont beaucoup plus discriminés donc nous avons décidé de ne conserver que cet indicateur permettant de construire des topics avec des termes suffisamment exclusifs de chaque topic.

Nous avons aussi essayé de conserver tous les mots dans l’espace latent final, cependant appliquer un filtre de fréquence (si un terme n’apparait qu’un nombre x minimal de fois dans l’ensemble des exécutions de l’algorithme) permet de réduire le nombre de points et de conserver des mots qui se retrouvent dans au moins plusieurs lda.

Nous réalisons n = 10 LDA que nous lançons à partir d’une seed aléatoire (que ici nous fixerons pour que les résultats soient exactement identiques).

5 Réalisation

5.1 Initialisation aléatoire et hyperparamètres

seeds = sample(1:9999, 10, replace = F)

seeds = c(3644,491,1509,3734,4753,9597,7323,9369,659,4999) # vecteur conservé pour la reproductibilité

k = 9  # nb de topics 
nb_lda = length(seeds) # nb de lda

5.2 Création des modèles

# model1 <- lda.model(k = k, seed = seeds[1])
# model2 <- lda.model(k = k, seed = seeds[2])
# model3 <- lda.model(k = k, seed = seeds[3])
# model4 <- lda.model(k = k, seed = seeds[4])
# model5 <- lda.model(k = k, seed = seeds[5])
# model6 <- lda.model(k = k, seed = seeds[6])
# model7 <- lda.model(k = k, seed = seeds[7])
# model8 <- lda.model(k = k, seed = seeds[8])
# model9 <- lda.model(k = k, seed = seeds[9])
# model10 <- lda.model(k = k, seed = seeds[10])

# save(model1,model2,model3,model4,model5,model6,model7,model8,model9,model10, file = "modeles.RData")

load("modeles.RData")

5.3 Extraction des termes

words1 <- topic.extraction(model1)
## A topic model with 9 topics, 360 documents and a 2708 word dictionary.
words2 <- topic.extraction(model2)
## A topic model with 9 topics, 360 documents and a 2708 word dictionary.
words3 <- topic.extraction(model3)
## A topic model with 9 topics, 360 documents and a 2708 word dictionary.
words4 <- topic.extraction(model4)
## A topic model with 9 topics, 360 documents and a 2708 word dictionary.
words5 <- topic.extraction(model5)
## A topic model with 9 topics, 360 documents and a 2708 word dictionary.
words6 <- topic.extraction(model6)
## A topic model with 9 topics, 360 documents and a 2708 word dictionary.
words7 <- topic.extraction(model7)
## A topic model with 9 topics, 360 documents and a 2708 word dictionary.
words8 <- topic.extraction(model8)
## A topic model with 9 topics, 360 documents and a 2708 word dictionary.
words9 <- topic.extraction(model9)
## A topic model with 9 topics, 360 documents and a 2708 word dictionary.
words10 <- topic.extraction(model10)
## A topic model with 9 topics, 360 documents and a 2708 word dictionary.
head(words1)
## [[1]]
## [1] "aop"      "court"    "circuit"  "attente"  "lait"     "bovin"    "domicile"
## 
## [[2]]
## [1] "atlantique" "serrer"     "carbone"    "maladie"    "mode"      
## [6] "protéine"   "gaz"       
## 
## [[3]]
## [1] "schéma"        "action"        "engager"       "inscrire"     
## [5] "communautaire" "partenaire"    "opérationnel" 
## 
## [[4]]
## [1] "gaspillage"      "egalim"          "collectif"       "restauration"   
## [5] "sensibilisation" "loi"             "précarité"      
## 
## [[5]]
## [1] "pression"          "artificialisation" "soumettre"        
## [4] "littoral"          "attractivité"      "climatique"       
## [7] "risque"           
## 
## [[6]]
## [1] "vallée"     "regrouper"  "plaine"     "urbain"     "concentrer"
## [6] "montagne"   "situer"

on va ensuite mettre tous les mots ensemble :

lda_list <- list(words1,words2,words3,words4,words5,words6,words7,words8,words9,words10)
# on créé la liste avec les mots de chaque lda : n objets, contenant chacun k éléments (9 ici)

words <- unique(unlist(lda_list))# récupére la liste unique des mots de toutes les lda
# ajouter toutes les listes de mots

et on créé un tableau de données contenant en ligne les mots, en colonne chaque topic de chaque lda, et au croisement un “1” si le mot se retrouve dans les termes sélectionnés caractérisant ce topic, et sinon un “0”.

# Créer le data frame 

col = paste0("lda", rep(1:nb_lda, each = k), "_topic", rep(1:k, times = nb_lda))
# on crée un vecteur avec les noms de colonnes avec x lda et n topics, et on le met dans l'ordre des lda
# c'est le vecteur des noms de colonnes de notre df 

mfa.df = data.frame(matrix(ncol = k *nb_lda, nrow = length(words), NA))
# on créé le df => 1 + k * n colonnes , on le remplit de NA
colnames(mfa.df) <- col
# on met les noms de colonnes issus du vecteur col
rownames(mfa.df) <- words 
# on ajoute les mots dans la colonne words

On va ensuite remplir le df :

# On va ensuite associer à chaque lda les mots des différents topics 

for (i in 1:nb_lda) {
  for (j in 1:k) {
    col_name <- paste0("lda", i, "_topic", j)
    
    # récupération des mots du topic j de la lda i
    words_in_topic <- lda_list[[i]][[j]]
    # lda_list[[i]][[j]] retourne les mots du topic j de la lda i
    
    # pour chaque mot du dataframe
    mfa.df[[col_name]] <- ifelse(
      rownames(mfa.df) %in% words_in_topic,
      1,  # si le mot est dans ce topic
      0  
    )
  }
}

head(mfa.df[,1:10])

Et on impose un filtre qui va d’abord calculer la somme de chaque ligne = le nombre de 1 = le nombre d’occurence de chaque mot sur l’ensemble des lda dans l’ensemble des topics Si cette fréquence est de 1, alors le mot (la ligne) est supprimée. On récupère ensuite le df final.

mfa.df.filtre <- mfa.df
mfa.df.filtre$freq <- apply(mfa.df, 1, sum)

# avec freq >= 2
mfa.df.filtre <- subset(mfa.df.filtre, freq>=2)

mfa.df.final <- mfa.df.filtre[,-ncol(mfa.df.filtre)] # supprimer la colonne fréquence 

summary(colSums(mfa.df.final)) # on vérifie le nombre min, max, médian, moyen de mots par thèmes pour voir l'impact du filtrage 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   5.000   6.000   5.722   7.000   7.000
dim(mfa.df)
## [1] 247  90
dim(mfa.df.final)
## [1] 132  90

On va ensuite comparer deux méthodes pour l’obtention des formes fortes : un AFM avec autant de groupes de variables que de nb.lda et pour chaque groupe autant de variables que de k, et une AFC avec une transformation des fréquences en modalités, et autant de variables de termes uniques dans le vocabulaire.

5.4 AFM

L’AFM est une analyse dimensionnelle qui permet d’imposer une structure sur les variables, ce qui est nécessaire ici car chaque topic n’a de sens qu’au sein d’une exécution de la LDA, et les mots peuvent être parfois partagés au sein d’une lda ou entre topics de plusieurs LDA.

res.mfa <- MFA(base = mfa.df.final, 
              group = rep(k,nb_lda),
              type = rep("f",nb_lda), 
              name.group = paste0("lda",seq(1:nb_lda)),
              graph = FALSE
              )

# on affiche le scree plot pour choisir le nombre de composantes à conserver

barplot(res.mfa$eig[1:40,2])

# on retient 5 composantes

res.mfa <- MFA(base = mfa.df.final, 
              group = rep(k,nb_lda),
              type = rep("f",nb_lda), 
              name.group = paste0("lda",seq(1:nb_lda)),
              ncp = 5
              # graph = F
              )

On réalise ensuite une classification hierarchique de nos individus (mots).

clustopt <- HCPC(res = res.mfa, nb.clust = -1) # nb optimal de classes

# 6 = nb optimal de classes

On regarde le nombre optimal de clusters, les mots qui les composent et on essaye d’optimiser ce nombre de clusters.

clust7<- HCPC(res = res.mfa, nb.clust = 7, graph = FALSE)
clust8<- HCPC(res = res.mfa, nb.clust = 8, graph = F)

Quel nombre de cluster a le plus de sens ?

plot_clust <- function(res.hcpc){
  
  clust <- data.frame(cbind(word = rownames(mfa.df.final),
                           clust = res.hcpc$data.clust$clust, 
                           dim1 = res.mfa$ind$coord[,1], 
                           dim2 = res.mfa$ind$coord[,2]))

  str(clust)
  clust$clust <- as.factor(clust$clust)
  clust$word <- as.factor((clust$word))
  clust$dim1 <- as.numeric(clust$dim1)
  clust$dim2 <- as.numeric(clust$dim2)
  
  plot <- plot_ly(
  data = clust,
  x = ~dim1,
  y = ~dim2,
  type = "scatter",
  mode = "markers+text",
  color = ~factor(clust),
  text = ~word,       # nom de ta colonne contenant les mots
  textposition = "top center",
  marker = list(size = 7),
  hoverinfo = "text"
) %>%
  layout(
    title = "Projection des mots dans l'espace factoriel (Dim 1 & Dim 2)",
    xaxis = list(
      title = "Dimension 1",       # supprime le titre
      showticklabels = FALSE,  # supprime les graduations
      zeroline = FALSE
    ),
    yaxis = list(
      title = "Dimension 2",
      showticklabels = FALSE,
      zeroline = FALSE
    ),
    legend = list(title = list(text = "Cluster"))
  )
  
  plot
}
# nombre optimal 
plot_clust(clustopt)
## 'data.frame':    132 obs. of  4 variables:
##  $ word : chr  "aop" "court" "circuit" "attente" ...
##  $ clust: chr  "3" "5" "5" "5" ...
##  $ dim1 : chr  "0.60036319115433" "0.83289278248596" "0.832892782485965" "0.922033804101742" ...
##  $ dim2 : chr  "-0.127983810117255" "1.00662789372137" "1.00662789372137" "0.320516068032617" ...
plot_clust(clust7)
## 'data.frame':    132 obs. of  4 variables:
##  $ word : chr  "aop" "court" "circuit" "attente" ...
##  $ clust: chr  "5" "6" "6" "6" ...
##  $ dim1 : chr  "0.60036319115433" "0.83289278248596" "0.832892782485965" "0.922033804101742" ...
##  $ dim2 : chr  "-0.127983810117255" "1.00662789372137" "1.00662789372137" "0.320516068032617" ...
plot_clust(clust8)
## 'data.frame':    132 obs. of  4 variables:
##  $ word : chr  "aop" "court" "circuit" "attente" ...
##  $ clust: chr  "5" "6" "6" "6" ...
##  $ dim1 : chr  "0.60036319115433" "0.83289278248596" "0.832892782485965" "0.922033804101742" ...
##  $ dim2 : chr  "-0.127983810117255" "1.00662789372137" "1.00662789372137" "0.320516068032617" ...

On choisit le nombre de clusters retenus :

res.hcpc <- HCPC(res = res.mfa, nb.clust = 6)

et on extrait les coordonnées des individus et leur appartenance à un cluster :

# création du jdd contenant les mots, leurs coordonnées sur les dimensions 1 et 2 ainsi que leur topic
clust <- data.frame(cbind(word = rownames(mfa.df.final),
                           clust = res.hcpc$data.clust$clust, 
                           dim1 = res.mfa$ind$coord[,1], 
                           dim2 = res.mfa$ind$coord[,2]))

str(clust)
## 'data.frame':    132 obs. of  4 variables:
##  $ word : chr  "aop" "court" "circuit" "attente" ...
##  $ clust: chr  "3" "5" "5" "5" ...
##  $ dim1 : chr  "0.60036319115433" "0.83289278248596" "0.832892782485965" "0.922033804101742" ...
##  $ dim2 : chr  "-0.127983810117255" "1.00662789372137" "1.00662789372137" "0.320516068032617" ...
clust$clust <- as.factor(clust$clust)
clust$word <- as.factor((clust$word))
clust$dim1 <- as.numeric(clust$dim1)
clust$dim2 <- as.numeric(clust$dim2)

head(clust)

On récupère ensuite l’ensemble des mots de chaque clusters et on réalise l’extraction de la variable latente (nom du topic)

# récupération des mots de chaque clusters 
mots.clust <- tapply(
  clust$word,     # Le vecteur à appliquer la fonction (les Mots)
  clust$clust, # Le facteur de regroupement (les Clusters)
  paste,                # La fonction à appliquer
  collapse = ", ")       # L

# interprétation avec naileR (à faire plus tard)

identification des variables latentes avec LLM :

  1. Gouvernance et Pilotage Territorial
  2. Alimentation Durable et Restauration Collective
  3. Caractéristiques Géographiques et Démographiques du Territoire
  4. Défis Climatiques et Environnementaux
  5. Filières Agricoles et Circuits de Distribution
  6. Structures et Dynamiques Agricoles

5.5 Test AFM quali

Nous avons aussi essayé une AFM avec comme classe de variable ‘n’ => catégorielle.

afm.quali <- data.frame(lapply(mfa.df.final, FUN = as.factor ))
rownames(afm.quali) <- rownames(mfa.df.final)
# str(head(afm.quali))

res.fma.q <- MFA(base = afm.quali, 
                 group = rep(k,nb_lda),
                 type = rep("n",nb_lda), 
                 name.group = paste0("lda",seq(1:nb_lda))
                 )

Il semblerait difficile d’identifier des formes fortes car en utilisant un type catégorielle, les mots ‘…’ , … tirent fortement les axes donc cette méthode ne permet pas de consolider notre LDA.

5.6 AFC

afc.df <- data.frame(t(mfa.df.final))
# str(head(afc.df))

res.afc <- CA(afc.df)

barplot(res.afc$eig[,2]) # on retient 5 ncp 

res.afc <- CA(afc.df, ncp = 5)

plot.CA(res.afc, invisible = "row")

Si on fait une classification issue du résultat de l’AFC, il semblerait que les formes fortes observées soient les mêmes que dans la méthode 1.

# coord.afc <- data.frame(cbind(dim1= res.afc$col$coord[,1], 
#                               dim2= res.afc$col$coord[,1]))
# head(coord.afc)
# 
# hcpc.afc <- HCPC(coord.afc, nb.clust = -1)
# 
# plot_clust(hcpc.afc)
#

6 Conclusion

Il semble intéressant d’utiliser des analyses factorielles pour consolider nos topic modellings et obtenir des formes fortes de nos topics. Après avoir lancé cet algorithme en faisant varier beaucoup les paramètres, on a pu observer une relative sensabilité à la modification de la stop_words liste des mots, ainsi évidemment qu’au paramètre k, ainsi que des topics très “forts” toujours retrouvés et composés des mêmes termes.

Le résultat présenté (6 clusters) nous semble cohérents au vue de tous les essais réalisés, rendant compte de thématiques qui portent du sens (bien que certaines soient composés de plusieurs sous-sujets), et que l’on a retrouvé systématiquement.